home *** CD-ROM | disk | FTP | other *** search
/ PC World 2007 March / PCWorld_2007-03_cd.bin / domacnost a kancelar / scribus / scribus-1.3.3.7-win32-install.exe / tcl / tk8.4 / demos / msgbox.tcl < prev    next >
Text File  |  1998-09-14  |  2KB  |  66 lines
  1. # msgbox.tcl --
  2. #
  3. # This demonstration script creates message boxes of various type
  4. #
  5. # RCS: @(#) $Id: msgbox.tcl,v 1.2 1998/09/14 18:23:29 stanton Exp $
  6.  
  7. if {![info exists widgetDemo]} {
  8.     error "This script should be run from the \"widget\" demo."
  9. }
  10.  
  11. set w .msgbox
  12. catch {destroy $w}
  13. toplevel $w
  14. wm title $w "Message Box Demonstration"
  15. wm iconname $w "messagebox"
  16. positionWindow $w
  17.  
  18. label $w.msg -font $font -wraplength 4i -justify left -text "Choose the icon and type option of the message box. Then press the \"Message Box\" button to see the message box."
  19. pack $w.msg -side top
  20.  
  21. frame $w.buttons
  22. pack $w.buttons -side bottom -fill x -pady 2m
  23. button $w.buttons.dismiss -text Dismiss -command "destroy $w"
  24. button $w.buttons.code -text "See Code" -command "showCode $w"
  25. button $w.buttons.vars -text "Message Box"  \
  26.     -command "showMessageBox $w"
  27. pack $w.buttons.dismiss $w.buttons.code $w.buttons.vars -side left -expand 1
  28.  
  29. frame $w.left 
  30. frame $w.right
  31. pack $w.left $w.right -side left -expand yes -fill y  -pady .5c -padx .5c
  32.  
  33. label $w.left.label -text "Icon"
  34. frame $w.left.sep -relief ridge -bd 1 -height 2
  35. pack $w.left.label -side top
  36. pack $w.left.sep -side top -fill x -expand no
  37.  
  38. set msgboxIcon info
  39. foreach i {error info question warning} {
  40.     radiobutton $w.left.b$i -text $i -variable msgboxIcon \
  41.     -relief flat -value $i -width 16 -anchor w
  42.     pack $w.left.b$i  -side top -pady 2 -anchor w -fill x
  43. }
  44.  
  45. label $w.right.label -text "Type"
  46. frame $w.right.sep -relief ridge -bd 1 -height 2
  47. pack $w.right.label -side top
  48. pack $w.right.sep -side top -fill x -expand no
  49.  
  50. set msgboxType ok
  51. foreach t {abortretryignore ok okcancel retrycancel yesno yesnocancel} {
  52.     radiobutton $w.right.$t -text $t -variable msgboxType \
  53.     -relief flat -value $t -width 16 -anchor w
  54.     pack $w.right.$t -side top -pady 2 -anchor w -fill x
  55. }
  56.  
  57. proc showMessageBox {w} {
  58.     global msgboxIcon msgboxType
  59.     set button [tk_messageBox -icon $msgboxIcon -type $msgboxType \
  60.     -title Message -parent $w\
  61.     -message "This is a \"$msgboxType\" type messagebox with the \"$msgboxIcon\" icon"]
  62.     
  63.     tk_messageBox -icon info -message "You have selected \"$button\"" -type ok\
  64.     -parent $w
  65. }
  66.